Parcial 4

## Registered S3 method overwritten by 'httr':
##   method         from  
##   print.response rmutil

## Warning: package 'tseries' was built under R version 4.3.2

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

## Warning: package 'cowplot' was built under R version 4.3.2

## Warning: package 'devtools' was built under R version 4.3.2

## Loading required package: usethis

## Warning: package 'usethis' was built under R version 4.3.2

Actividad 1

Punto A

Crear una muestra aleatoria de tamaño 120

#primero leemos el excel y lo guardamos en un data frame en este caso :
Blackfriday=data.frame(read_xlsx("C:/Users/alejo/Desktop/Blackfriday.xlsx"))
#Despues establecemos el tamaño de la muestra y con ese tamaño usamos la funcion sample:
n=120
muestra=sample(1:nrow(Blackfriday),size=n,replace=FALSE)
#Finalmente relacionamos nuestra muestra con los datos obtenidos del excel:
datosfinales = Blackfriday[muestra, ]
datosfinales

Punto B

Gender

datosproblema=data.frame(table(datosfinales$Gender))
datosproblema

valores= datosproblema$Freq
nombres_porcentajes=c("Mujer","Hombre")
porcentajes <- (valores / sum(valores)) * 100
colores <- c("#3498db", "#e74c3c")
plot_ly(labels = nombres_porcentajes, values = porcentajes, type = "pie",
        textinfo = "label+percent", text = datosproblema$Var1 , marker = list(colors = colores)) %>%
  layout(title = list(font="Porcentajes Entre Hombre y Mujer"),
         showlegend = FALSE,  # Ocultar la leyenda
         margin = list(l = 20, r = 0, b = 0, t = 30),  # Ajustar márgenes
         paper_bgcolor = "white",  # Fondo blanco
         plot_bgcolor = "white",  # Fondo blanco
         font = list(family = "Arial", size = 14),  # Fuente y tamaño de texto
         titlefont = list(size = 18),  # Tamaño del título
         annotations = list(text = "Fuente: Datos de ejemplo", showarrow = FALSE,
                            x = 0.8, y = -0.15))  # Nota de fuente

## Warning: The titlefont attribute is deprecated. Use title = list(font = ...)
## instead.

Al ser una variable cualitativa no podemos obtener sus medidas de tendencia central, sin embargo como se vera mas a delante la usaremos para generar grupos de datos y asi hacer su respectivo analisis

City_category

datosproblema=data.frame(table(datosfinales$City_Category))
datosproblema

valores= datosproblema$Freq
nombres_porcentajes=c("CITY A","CITY B","CITY C")
porcentajes <- (valores / sum(valores)) * 100
colores <- c("#BFCDFF", "#E4FFBF","#B8FFD9")
plot_ly(labels = nombres_porcentajes, values = datosproblema$Freq, type = "pie",
        textinfo = "label+percent", text = datosproblema$Var1 , marker = list(colors = colores)) %>%
  layout(title = list(font="Porcentajes de ciudades en la muestra"),
         showlegend = FALSE,  # Ocultar la leyenda
         margin = list(l = 20, r = 0, b = 0, t = 30),  # Ajustar márgenes
         paper_bgcolor = "white",  # Fondo blanco
         plot_bgcolor = "white",  # Fondo blanco
         font = list(family = "Arial", size = 14),  # Fuente y tamaño de texto
         titlefont = list(size = 18),  # Tamaño del título
         annotations = list(text = "Fuente: Datos de ejemplo", showarrow = FALSE,
                            x = 0.8, y = -0.15))  # Nota de fuente

## Warning: The titlefont attribute is deprecated. Use title = list(font = ...)
## instead.

income

datosproblema=datosfinales$Income
Media_Datos=median(datosproblema)
Moda=mfv(datosproblema)
Promedio=mean(datosproblema)

#hist(datosproblema)
g1 = ggplot(data = data.frame(datosproblema),mapping = aes(x = datosproblema)) +
  geom_histogram(bins = 20,colour="white",fill="#FFEA89")+
            labs(title = "Histograma income", y ="Cantidad") +
            geom_vline(aes(xintercept= Promedio ,color ="MEDIA"),linetype = "dashed",linewidth = 0.5) +
            geom_vline(aes(xintercept= Media_Datos,color = "MEDIANA"),linetype = "dashed",linewidth = 1) + 
           scale_color_manual(name = "Informacion",values = c(MEDIANA ="blue" ,MEDIA = "red",MODA ="purple"))
g1

#boxplot(datosproblema, col="#BF89FF",xlab="Habitantes",ylab="Edad")
#stripchart(datosproblema, method = "jitter", pch = 19, add = TRUE, col = "blue")

Punto C

primero cacularemos la media y desviacion estandar de la poblacion general

## La media de la poblacion es: 9508.259

## La desviacion estandar de la poblacion es: 5001.657

Ahora calcularemos la media y desviacion estandar de la muestra

## La media de la muestra  es: 9993.358

## La desviacion estandar de la muestra es: 5360.271

En situiaciones como estas el estimador es la MUESTRA, esto debido a que normalmente se desconocen todos los datos de l apoblacion, por lo cual se toma una muestra lo suficientemente grande para obtener los datos mas cercanos posibles desconociendo la totalidad de los datos de la poblacion

Ahora miraremos la probabilidad de que la variable media muestral sea mayor o igual que el valor de la poblacional.

z <- round(( mean(Blackfriday$Purchase) - mean(datosfinales$Purchase))/sd(datosfinales$Purchase),2)
probabilidad <- round(pnorm(q=z,mean = 0, sd=1,lower.tail = FALSE),1)

cat("la probabilidad de que la variable media muestral sea mayor o igual que el valor de la
poblacional es de :",(probabilidad*100),"%")

## la probabilidad de que la variable media muestral sea mayor o igual que el valor de la
## poblacional es de : 50 %

Al no haber una inclinacion muy marcada o significativa en que la media muestral sea igual o mayor que la media poblacional se considera que los segos son muy bajos por no decir inexistentes

Punto D

datosproblema=datosfinales$Purchase
Mediana_Datos=round(median(datosproblema),0)
Moda=mfv(datosproblema)
Promedio=round(mean(datosproblema),0)
sdi=round(sd(datosproblema),0)

#hist(datosproblema)
g1 = ggplot(data = data.frame(datosproblema),mapping = aes(x = datosproblema)) +
  geom_histogram(bins = 20,colour="white",fill="#FFBCFD")+
            labs(title = "Histograma variable PurchaseS", y ="Cantidad") +
            #geom_vline(aes(xintercept= Promedio ,color ="MEDIA"),linetype = "dashed",linewidth = 1) +
            #(aes(xintercept= Media_Datos,color = "MEDIANA"),linetype = "dashed",linewidth = 1) + 
           #scale_color_manual(name = "Informacion",values = c(MEDIANA ="#5DFF00" ,MEDIA = "#6E00FF")) +
          stat_function(fun = dnorm, n = 10000, args = list(mean = Promedio, sd = sdi)) + ylab("") +
  scale_y_continuous(breaks = NULL)
g1

Ahora caalcularemos la courtosis :

curti=kurtosis(datosfinales$Purchase)
cat("la curtosis de la variable purchasae de la muestra aes: ",curti)

## la curtosis de la variable purchasae de la muestra aes:  3.057671

Esta curtosis positiva nos indica que la distribucion es elevada, sin embargo el resultado es apenas notable comparado con la distribucion normal

Ahora calcularemos la asimetria con la funcion skewness

  datosproblema=datosfinales$Purchase
asimetria=skewness(datosproblema)
cat("la asimetria da :",asimetria)

## la asimetria da : 0.08577722

Lo cual nos indica que tiene un sesgo muy pequeño hacia la derecha

plot(datosfinales$Purchase, dnorm(datosfinales$Purchase, mean = mean(datosfinales$Purchase), sd = sd(datosfinales$Purchase)), type = "l",
     ylim = c(0, 0.0001), ylab = "", lwd = 2, col = "red")

 x=dnorm(datosfinales$Purchase, mean = mean(datosfinales$Purchase), sd = sd(datosfinales$Purchase))
x

##   [1] 6.430839e-05 7.010608e-05 7.439491e-05 7.219513e-05 3.983398e-05
##   [6] 6.748213e-05 6.863038e-05 6.052117e-05 6.929327e-05 2.805713e-05
##  [11] 7.231322e-05 6.173723e-05 5.443746e-05 2.205384e-05 4.428188e-05
##  [16] 5.367712e-05 4.632793e-05 1.175436e-05 1.253379e-05 3.690165e-05
##  [21] 7.438640e-05 1.378535e-05 4.169219e-05 5.821189e-05 6.412150e-06
##  [26] 4.793309e-05 3.129848e-05 7.354869e-05 4.248024e-05 6.210657e-05
##  [31] 5.098477e-05 6.499493e-05 7.388164e-05 7.409963e-05 5.473989e-05
##  [36] 6.952545e-05 7.385240e-05 7.379268e-05 7.042612e-05 4.924722e-05
##  [41] 4.808167e-05 2.951911e-06 7.264300e-05 3.729134e-05 3.645394e-05
##  [46] 3.632982e-05 7.430901e-05 5.117260e-05 5.729111e-05 6.247404e-05
##  [51] 6.221094e-06 2.561963e-05 7.277772e-05 6.254293e-05 7.354386e-05
##  [56] 4.947255e-05 7.104138e-05 6.168790e-05 6.448292e-05 3.890566e-05
##  [61] 7.269044e-05 8.605669e-06 1.868049e-05 7.338323e-05 3.033603e-06
##  [66] 7.100084e-05 5.525067e-05 2.959007e-05 4.825771e-05 7.245561e-05
##  [71] 4.562920e-05 7.393059e-05 6.827900e-05 7.001648e-05 3.062528e-05
##  [76] 5.217719e-05 4.329510e-05 2.994128e-05 5.233297e-05 6.381284e-05
##  [81] 6.696160e-05 7.383911e-05 6.818348e-05 4.359785e-05 7.222164e-05
##  [86] 1.097651e-05 1.448215e-05 7.131392e-05 6.508764e-05 7.358159e-05
##  [91] 3.718506e-05 6.924920e-05 6.976686e-05 7.442449e-05 7.369377e-05
##  [96] 4.718578e-05 7.188658e-05 2.258918e-06 7.174338e-05 6.748612e-05
## [101] 7.438672e-05 6.371174e-05 7.434069e-05 6.242573e-05 7.252392e-05
## [106] 1.360202e-05 7.362313e-05 5.149686e-05 6.081063e-05 7.381105e-05
## [111] 4.170294e-05 1.141554e-05 4.741025e-05 6.003718e-05 6.400840e-05
## [116] 7.335312e-05 3.835269e-05 6.344544e-05 4.447314e-05 4.500603e-05

Actividad 2

Actividad 3

Punto A

La hipotesis nula se plantea como: u es menor o igual a el valor real encontrado en la población

La hipotesis alternativa se plantea como: u es mayor a el valor real encontrado en la población

#poblacion
media_poblacion

## [1] 9508.259

desviacion_Estandar_poblacion

## [1] 5001.657

#muestra
media_muestra

## [1] 9993.358

desviacion_Estandar_muestra

## [1] 5360.271

formz3A=(media_muestra-media_poblacion)/(desviacion_Estandar_muestra/sqrt(120))
pnorm(formz3A)

## [1] 0.8392467

El valor de 0.8392467 cae dentro de la región de aceptación de la hipotesis nula, por lo tanto se puede decir que el el valor u es menor o igual al valor real encontrado en la población, por lo tanto se puede decir que las personas compran menos que el valor promedio.

Punto B

muestraP3 <- subset(Blackfriday,select=c(Gender,Purchase))
#tamaño de la muestrs 120
n=120
#se extraen los datos de la población femenina
PoblacionF <- subset(muestraP3,Gender=="F")
muestraF <- sample(PoblacionF$Purchase,size=n,replace=FALSE,prob=NULL)
comprasPromF <- mean(PoblacionF$Purchase)
PromMuestraF <- mean(muestraF)
sdcompraspromF <- sd(PoblacionF$Purchase)
sdPromMuestraF <- sd(muestraF)
#se extraen los datos de la población masculina
PoblacionM <- subset(muestraP3,Gender=="M")
muestraM <- sample(PoblacionM$Purchase,size=n,replace=FALSE,prob=NULL)
ComprasPromM <- mean(PoblacionM$Purchase)
PromMMuestra <- mean(muestraM)
sdcompraspromM <- sd(PoblacionM$Purchase)
sdPromMuestraM <- sd(muestraM)

Creamos los filtros para las muestras de genero por Masculino y Femenino. En el dataframe se encuentran como masculino M y femenino F obtenemos tambien el promedio y la desviación estandar de cada muestra.

Estos son los datos para la poblacion y muestra Femenina

cat("La muestra femenina es:",muestraF)

## La muestra femenina es: 19585 11820 5711 15687 5760 17662 9739 12154 2162 5524 8144 14218 -6533 7345 6004 10925 6587 12333 12024 11175 5681 8092 26275 10968 8499 10111 7656 9297 8440 5260 6768 3118 11969 14942 3321 16712 12516 14705 6281 4084 6074 1551 5672 11589 17283 -686 11979 17168 6038 8050 11000 14631 4881 13287 12083 11961 13525 10523 11228 8125 10239 7708 12167 10099 2238 9024 -4069 14849 8848 -3589 11512 19068 10904 13933 15979 10782 12087 10340 10081 10379 10542 9888 7961 13875 6963 13181 14584 3184 20447 6354 12222 14277 7459 10165 12801 6705 20163 -256 12404 1125 10114 2709 4283 7616 6938 11770 8114 5185 18458 15281 8476 5341 11124 15717 11818 11353 7181 9250 8953 11983

#cat("La población femenina es:",PoblacionF$Purchase)
cat("\nEl promedio de la población femenina es:",comprasPromF)

## 
## El promedio de la población femenina es: 9506.636

cat("\nEl promedio de la muestra femenina es:",PromMuestraF)

## 
## El promedio de la muestra femenina es: 9724.75

cat("\nLa desviación estandar de la población femenina es:",sdcompraspromF)

## 
## La desviación estandar de la población femenina es: 5015.093

cat("\nLa desviación estandar de la muestra femenina es:",sdPromMuestraF)

## 
## La desviación estandar de la muestra femenina es: 5143.279

Estos son los datos para la poblacion y muestra Masculina

cat("La muestra masculina es:",muestraM)

## La muestra masculina es: 13761 9542 18549 7291 7885 11621 -3255 10942 5664 3690 16094 16187 7149 8163 19805 12102 10786 20167 2043 13292 11606 7998 22325 13350 14147 4973 15033 12940 14177 7140 9078 -6132 11285 9642 12721 7230 7760 3302 -4024 13315 12445 9032 4667 11504 21910 6618 16308 4778 9068 13766 5727 12590 2267 10286 9463 4863 3095 8510 1920 11168 12411 10219 18781 11732 5547 17999 276 13818 9902 5440 15703 284 14930 8469 18788 11799 12626 8546 5240 3315 4032 15500 10962 4678 1966 11138 8129 4886 6519 10431 1319 8490 17967 6900 10667 7827 13280 4672 3118 13915 4599 13031 7069 7708 9827 17951 9969 15105 2440 6191 2650 13621 4825 11108 10104 4556 6836 15406 13617 10223

#cat("La población femenina es:",PoblacionF$Purchase)
cat("\nEl promedio de la población masculina es:",ComprasPromM)

## 
## El promedio de la población masculina es: 9508.792

cat("\nEl promedio de la muestra masculina es:",PromMMuestra)

## 
## El promedio de la muestra masculina es: 9486.55

cat("\nLa desviación estandar de la población masculina es:",sdcompraspromM)

## 
## La desviación estandar de la población masculina es: 4997.311

cat("\nLa desviación estandar de la muestra masculina es:",sdPromMuestraM)

## 
## La desviación estandar de la muestra masculina es: 5376.969

La hipotesis que platearemos es si hay diferencia entre ambas poblaciones por lo tanto se plantea que H0:μ1-μ2 != media

la hipotesis alternativa se plantearia como H1:μ1-μ2 = media

z3B <- ((PromMMuestra-PromMuestraF))/(sqrt(((sdPromMuestraM*sdPromMuestraM)/120)+((sdPromMuestraF*sdPromMuestraF)/120)))
z3B

## [1] -0.3506827

pnorm(z3B)

## [1] 0.3629132

Con un nivel de significancia del 5% se puede decir que la diferencia entre el promedio de gastos masculino y el promedio de compras femenino es diferente por lo tanto la hipotesis H0 es correcta y se puede decir que la

Punto C

Calcularemos un intervalo de confianza de una cola para las varianzas de la muestra de compras masculino y femenino.

if (!require('devtools')) install.packages('devtools')
devtools::install_github('fhernanb/stests', force=TRUE)

## Downloading GitHub repo fhernanb/stests@HEAD

## 
## ── R CMD build ─────────────────────────────────────────────────────────────────
##   
  
  
   checking for file 'C:\Users\alejo\AppData\Local\Temp\RtmpKoNqBv\remotes51b448b040a\fhernanb-stests-61c62f1/DESCRIPTION' ...
  
✔  checking for file 'C:\Users\alejo\AppData\Local\Temp\RtmpKoNqBv\remotes51b448b040a\fhernanb-stests-61c62f1/DESCRIPTION'
## 
  
  
  
─  preparing 'stests': (515ms)
##    checking DESCRIPTION meta-information ...
  
✔  checking DESCRIPTION meta-information
## 
  
  
  
─  checking for LF line-endings in source and make files and shell scripts
## 
  
─  checking for empty or unneeded directories
##    Omitted 'LazyData' from DESCRIPTION
## 
  
  
  
─  building 'stests_0.1.0.tar.gz'
## 
  
   
## 

## Installing package into 'C:/Users/alejo/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)

stests::var.test(c(sdcompraspromM,sdcompraspromF)) 

## 
##  X-squared test for variance
## 
## data:  c(sdcompraspromM, sdcompraspromF)
## X-squared = 158.11, df = 1, p-value < 2.2e-16
## alternative hypothesis: true variance is not equal to 1
## 95 percent confidence interval:
##      31.47096 160993.26013
## sample estimates:
## variance of x 
##      158.1065

Punto D

Tenemos como hipotenis nula que la igualdad de las varianzas de las compras de hombres y mujeres. H0:sμ1 = sμ2 como hipotesis alternativa se tiene que son diferentes. H1:sμ1 != sμ2

PruebaHipVarianzas <- ((sdcompraspromM*sdcompraspromM)/(sdcompraspromF*sdcompraspromF))

PruebaHipVarianzas

## [1] 0.992921

gradosLibertad <- 119/119

valorCritico <- 1.35
valorCritico

## [1] 1.35

Con los valores del valor critico que equivale a 1.35 y el valor del estadistico de prueba equivale a 0.99291 se concluye que como el estadistico es menor que el valor critico se rechaza la hipotesis nula. Por lo tanto la hipotesis alternativa es verdadera entonces la varianza de ambos son diferentes